Tricks of the Mac Game Programming Gurus/TricksOfTheMacGameProgrammingGurus.iso/More Source/Pascal/Carl O's Term/Term.Pas

Pascal/Delphi Source File | 1994-10-14 | 18.5 KB | 685 lines | [TEXT/PJMM]

{From: "Carl O" <[e-mail]>}
{Subject: Mac Serial I/O code}
{}
{Attached is my Mac serial code.  The program is a complete simple terminal}
{emulator that used some popup menu buttons that I was experimenting with.}
{You can just trash those if you like--the actual serial port code is what}
{I think you are interested in.  Any questions, just ask.}
{}
{Carl R. Osterwald}

{Changes by Ingemar Ragnemalm:}
{Changed RamSDOpen/RamSDClose to OpenDriver/CloseDriver.}
{Removed or commented out some stuff that don't apply to Think Pascal.}
{Changed some identifiers to get closer to the Mac standard.}
{Added some minor GUI features like Apple menu and About box.}

program Term;

    uses
{$IFC UNDEFINED THINK_PASCAL}
{Change these to, for example, MPW interfaces.}
        MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf, OSErrTrap,
{$ENDC}
        Serial;

    type
        Pac2 = packed array[1..2] of char;
        Pac64 = packed array[1..64] of char;

    const
        kChanARcvAvail = 24;
        menu_ID = 1;
        aboutID = 128;
        appleMenu_ID = 2;
        baud_menu_ID = 235;
        parity_menu_ID = 234;
        quit_item = 1;
        about_item = 1;
        baud_300_item = 1;
        baud_600_item = 2;
        baud_1200_item = 3;
        baud_1800_item = 4;
        baud_2400_item = 5;
        baud_3600_item = 6;
        baud_4800_item = 7;
        baud_7200_item = 8;
        baud_9600_item = 9;
        baud_19200_item = 10;
        baud_57600_item = 11;
        no_parity_item = 1;
        even_parity_item = 2;
        odd_parity_item = 3;
        scroll_bar_width = 16;
        indent = 4;
        line_space = 11;
        char_space = 6;
        ascent = 9;
        descent = 2;
        loop_length = 16;
        flash_interval = $00000010;
        control_G = $07;
        control_H = $08;
        control_J = $0A;
        control_M = $0D;

    var
        appleMenu, menu: MenuHandle;
        baud_menu: MenuHandle;
        parity_menu: MenuHandle;
        menu_choice: LongInt;
        baud: integer;
        parity: integer;
        checked_baud: integer;
        checked_parity: integer;
        window_rectangle: Rect;
        terminal_window: WindowPtr;
        terminal_rectangle: Rect;
        temp_rectangle: Rect;
        temp_control: ControlHandle;
        break_button: ControlHandle;
        help_button: ControlHandle;
        update_region: RgnHandle;
        which_window: WindowPtr;
        which_control: ControlHandle;
        click_location: Point;
        current_event: EventRecord;
        finished: boolean;
        cursor_visible: Boolean;
        cursor_rectangle: Rect;
        next_flash_time: LongInt;
        xPos: integer;
        yPos: integer;
        received_char: char;
        buffer_ptr: Ptr;
        in_buffer: Pac64;
        this_char: Pac2;
        screen_line: string[80];
        width: integer;
        height: integer;
        right_limit: integer;
        bottom_limit: integer;
        no_of_lines: integer;
        index: integer;
        limit: integer;
        len: integer;
        configuration_word: integer;
        protocol_record: SerShk;
        byte_count: LongInt;
        num_string: Str255;

  {--------------------------------------------------------------------------}

    procedure ErrorHandler (theErr: OSErr);
    begin
        if theErr = noErr then
            exit(ErrorHandler);
        SysBeep(10);
        ExitToShell; {Eller halt?}
    end;

  {--------------------------------------------------------------------------}

    procedure ConfigureModemPort;

    begin { ConfigureModemPort }
        case checked_baud of
            baud_300_item:
                baud := baud300;
            baud_600_item:
                baud := baud600;
            baud_1200_item:
                baud := baud1200;
            baud_1800_item:
                baud := baud1800;
            baud_2400_item:
                baud := baud2400;
            baud_3600_item:
                baud := baud3600;
            baud_4800_item:
                baud := baud4800;
            baud_7200_item:
                baud := baud7200;
            baud_9600_item:
                baud := baud9600;
            baud_19200_item:
                baud := baud19200;
            baud_57600_item:
                baud := baud57600;
            otherwise
                baud := baud1200;
        end; { case }
        case checked_parity of
            no_parity_item:
                parity := noParity;
            even_parity_item:
                parity := evenParity;
            odd_parity_item:
                parity := oddParity;
            otherwise
                parity := evenParity;
        end; { case }
        configuration_word := BitOr(BitOr(baud, data7), BitOr(parity, stop10));
        ErrorHandler(SerReset(aInRefNum, configuration_word));
        ErrorHandler(SerReset(aOutRefNum, configuration_word));
        CheckItem(baud_menu, checked_baud, true);
        CheckItem(parity_menu, checked_parity, true);
    end; { ConfigureModemPort }

  {--------------------------------------------------------------------------}

    procedure ControlActionProcedure (which_control: ControlHandle; part_code: integer);
        var
            which_menu: integer;
            which_item: integer;
            menu_point: Point;
            menu_width: integer;

    begin { ControlActionProcedure }
        HLock(Handle(which_control));
        with which_control^^ do
            begin
                InsertMenu(MenuHandle(contrlRfCon), -1);
                CalcMenuSize(MenuHandle(contrlRfCon));
                menu_point.v := contrlRect.top;
                menu_point.h := contrlRect.left;
                LocalToGlobal(menu_point);
                menu_width := MenuHandle(contrlRfCon)^^.menuWidth + 2;
                with menu_point do
                    menu_choice := PopUpMenuSelect(MenuHandle(contrlRfCon), v - 1, h - menu_width, contrlMax);
                DeleteMenu(contrlMin);
                which_menu := HiWord(menu_choice);
                which_item := LoWord(menu_choice);
                case which_menu of
                    baud_menu_ID:
                        begin
                            CheckItem(baud_menu, contrlValue, false);
                            case which_item of
                                baud_300_item:
                                    baud := baud300;
                                baud_600_item:
                                    baud := baud600;
                                baud_1200_item:
                                    baud := baud1200;
                                baud_1800_item:
                                    baud := baud1800;
                                baud_2400_item:
                                    baud := baud2400;
                                baud_3600_item:
                                    baud := baud3600;
                                baud_4800_item:
                                    baud := baud4800;
                                baud_7200_item:
                                    baud := baud7200;
                                baud_9600_item:
                                    baud := baud9600;
                                baud_19200_item:
                                    baud := baud19200;
                                baud_57600_item:
                                    baud := baud57600;
                                otherwise
                                    which_item := contrlValue;
                            end; { case }
                            CheckItem(baud_menu, which_item, true);
                            checked_baud := which_item;
                            ContrlValue := which_item;
                            ConfigureModemPort;
                        end;
                    parity_menu_ID:
                        begin
                            CheckItem(parity_menu, contrlValue, false);
                            case which_item of
                                no_parity_item:
                                    parity := noParity;
                                even_parity_item:
                                    parity := evenParity;
                                odd_parity_item:
                                    parity := oddParity;
                                otherwise
                                    which_item := contrlValue;
                            end; { case }
                            CheckItem(parity_menu, which_item, true);
                            checked_parity := which_item;
                            ContrlValue := which_item;
                            ConfigureModemPort;
                        end;
                end; { case }
            end; { with }
        HLock(Handle(which_control));
    end; { ControlActionProcedure }

  {--------------------------------------------------------------------------}

{procedure RamSDOpen (whichPort: SPortSel): OSErr;}

    procedure InitializeModemPort;

        var
            aInRefNumDummy, aOutRefNumDummy: integer;
    begin { InitializeModemPort }
{RamSDOpen changed to OpenDriver}
{ErrorHandler(RamSDOpen(SPortA)); { open driver for modem port }

{ A = modem port, B = printer port}
        ErrorHandler(OpenDriver('.AIn', aInRefNumDummy));
        ErrorHandler(OpenDriver('.AOut', aOutRefNumDummy));

        ConfigureModemPort;
        with protocol_record do
            begin
                fXon := 0;                      { Xon/Xoff for output disabled }
                fCTS := 0;                      { CTS handshake disabled }
                errs := 0;                      { don't bother with errors }
                evts := 0;                      { don't post status events }
                fInX := 0;                      { Xon/Xoff for input disabled }
            end; { with }
        ErrorHandler(SerHShake(aInRefNum, protocol_record));
        ErrorHandler(SerHShake(aOutRefNum, protocol_record));
        this_char[1] := ' ';
    end; { InitializeModemPort }

  {--------------------------------------------------------------------------}

    procedure InitializeUserInterface;

    begin { intialize_user_interface }
{$IFC UNDEFINED THINK_PASCAL}
        InitGraf(@thePort);
        InitFonts;
        InitWindows;
        InitMenus;
        TEInit;
        InitDialogs(nil);
{$ENDC}
        FlushEvents(everyEvent, 0);

        appleMenu := NewMenu(appleMenu_ID, concat(char($14)));
        AppendMenu(appleMenu, 'About Term…;(-');
        AddResMenu(appleMenu, 'DRVR');
        InsertMenu(appleMenu, 0);

        menu := NewMenu(menu_ID, 'File');
        AppendMenu(menu, 'Quit/Q');
        InsertMenu(menu, 0);
        baud_menu := NewMenu(baud_menu_ID, 'Baud');
        AppendMenu(baud_menu, '300;600;1200;1800;2400;3600;4800;7200;9600;19200;57600;');
        parity_menu := NewMenu(parity_menu_ID, 'Parity');
        AppendMenu(parity_menu, 'None;Even;Odd');
        DrawMenuBar;
        width := 80 * char_space + scroll_bar_width + 2 * indent;
        height := 25 * line_space + 2 * indent;
        with window_rectangle do
            begin
                top := 50;
                bottom := top + height;
                left := (screenBits.Bounds.right - screenBits.Bounds.left - width) div 2;
                right := left + width;
            end; { with }
        terminal_window := NewWindow(nil, window_rectangle, 'Dumb Terminal Emulation', true, noGrowDocProc, WindowPtr(-1), false, 0);
        SetPort(terminal_window);
        terminal_rectangle := GrafPtr(terminal_window)^.portRect;
        ClipRect(terminal_rectangle);
        InsetRect(terminal_rectangle, indent, indent);
        with terminal_rectangle do
            right := right - scroll_bar_width;
        TextFont(Monaco);
        TextSize(9);
        TextMode(srcCopy);
        xPos := indent;
        yPos := indent + ascent;
        right_limit := terminal_rectangle.right - 1;
        no_of_lines := (terminal_rectangle.bottom - yPos) div line_space + 1;
        bottom_limit := yPos + (no_of_lines - 1) * line_space - 1;
        DrawGrowIcon(terminal_window);
        with GrafPtr(terminal_window)^.PortRect do
            begin
                PenPat(white);
                MoveTo(0, bottom - 15);
                LineTo(right - 16, bottom - 15);
                PenPat(black);
            end; { with }

        with GrafPtr(terminal_window)^.portRect do
            SetRect(temp_rectangle, right - 14, bottom - 29, right, bottom - 14);  { L T R B }
        break_button := NewControl(terminal_window, temp_rectangle, 'FFFF80019105890F851D8039B871802182018321871186498E418C418401FFFF', true, 0, 0, 0, $AAC0, 0);                          { break button }

        with GrafPtr(terminal_window)^.portRect do
            SetRect(temp_rectangle, right - 14, bottom - 44, right, bottom - 29);  { L T R B }
        checked_parity := even_parity_item;
        temp_control := NewControl(terminal_window, temp_rectangle, 'FFFF8001811D816183898D01F1098101A109811DA1018101A101F38187C1FFFF', true, checked_parity, parity_menu_ID, odd_parity_item, $AAC0, 0);                          { parity button }
        CheckItem(parity_menu, checked_parity, true);
        SetCRefCon(temp_control, LongInt(parity_menu));
        SetCtlAction(temp_control, @ControlActionProcedure);

        with GrafPtr(terminal_window)^.portRect do
            SetRect(temp_rectangle, right - 14, bottom - 59, right, bottom - 44);  { L T R B }
        checked_baud := baud_300_item;
        temp_control := NewControl(terminal_window, temp_rectangle, 'FFFF800181018101810180018001C023A025904980418081808181018101FFFF', true, checked_baud, baud_menu_ID, baud_57600_item, $AAC0, 0);                          { baud button }
        CheckItem(baud_menu, checked_baud, true);
        SetCRefCon(temp_control, LongInt(baud_menu));
        SetCtlAction(temp_control, @ControlActionProcedure);

        with GrafPtr(terminal_window)^.portRect do
            SetRect(temp_rectangle, right - 14, bottom - 74, right, bottom - 59);  { L T R B }
        help_button := NewControl(terminal_window, temp_rectangle, 'FFFF800183C18FF18C31981998199819807981E181818181800181818181FFFF', true, 0, 0, 0, $AAC0, 0);                           { help button }

        MoveTo(xPos, yPos);
        update_region := NewRgn;
        screen_line := '';
        next_flash_time := 0;
        cursor_visible := false;
        InitCursor;
        finished := false;
    end; { InitializeUserInterface }

  {--------------------------------------------------------------------------}

    procedure InvertCursor;

    begin { InvertCursor }
        SetRect(cursor_rectangle, xPos - 1, yPos - 2, xPos + 6, yPos + 1);
        InvertRect(cursor_rectangle);
        cursor_visible := not cursor_visible;
    end; { InvertCursor }

  {--------------------------------------------------------------------------}

    procedure HideTheCursor;

    begin { HideTheCursor }
        if cursor_visible then
            InvertCursor;
        next_flash_time := TickCount + flash_interval;
    end; { HideTheCursor }

  {--------------------------------------------------------------------------}

    procedure FlashCursor;
        var
            tick_count: LongInt;

    begin { FlashCursor }
        tick_count := TickCount;
        if tick_count > next_flash_time then
            begin
                InvertCursor;
                next_flash_time := tick_count + flash_interval;
            end;
    end; { FlashCursor }

  {--------------------------------------------------------------------------}

    procedure Linefeed;

    begin { Linefeed }
        HideTheCursor;
        if yPos > bottom_limit then
            ScrollRect(terminal_rectangle, 0, -line_space, update_region)
        else
            begin
                yPos := yPos + line_space;
                MoveTo(xPos, yPos);
            end;
    end; { Linefeed }

  {--------------------------------------------------------------------------}

    procedure CarriageReturn;

    begin { CarriageReturn }
        HideTheCursor;
        xPos := indent;
        MoveTo(xPos, yPos);
    end; { CarriageReturn }

  {--------------------------------------------------------------------------}

    procedure HandleMenuChoice;
        var
            which_menu: integer;
            which_item: integer;

            curPort: GrafPtr;
            str: Str255;

    begin { HandleMenuChoice }
        which_menu := HiWord(menu_choice);
        which_item := LoWord(menu_choice);
        case which_menu of
            appleMenu_ID:
                case which_item of
                    about_item:
                        if Alert(aboutID, nil) = 1 then
                            ;
                    otherwise
                        begin
                            GetPort(curPort);
                            GetItem(appleMenu, which_item, str);
                            if OpenDeskAcc(str) = 0 then
                                ;
                            SetPort(curPort);
                        end;
                end; { case }
            menu_ID:
                case which_item of
                    quit_item:
                        finished := true;
                end; { case }
        end; { case }
        HiLiteMenu(0);
    end; { HandleMenuChoice }

  {--------------------------------------------------------------------------}

    procedure CheckMousePosition;
        var
            stop_time: LongInt;

    begin { CheckMousePosition }
        case FindWindow(current_event.where, which_window) of
            inMenuBar:
                begin
                    menu_choice := MenuSelect(current_event.where);
                    HandleMenuChoice;
                end;
            inDrag:
                begin
                    if (which_window <> FrontWindow) and (BitAnd(current_event.modifiers, cmdKey) = 0) then
                        SelectWindow(which_window);
                    DragWindow(which_window, current_event.where, screenBits.bounds);
                end;
            inContent:
                begin
                    click_location := current_event.where;
                    GlobalToLocal(click_location);
                    if FindControl(click_location, terminal_window, which_control) <> 0 then
                        begin
                            if TrackControl(which_control, click_location, Ptr(-1)) = 1 then
                                begin
                                    if which_control = break_button then
                                        begin
                                            ErrorHandler(SerSetBrk(aOutRefNum));
                                            Delay(6, stop_time);
                                            ErrorHandler(SerClrBrk(aOutRefNum));
                                        end;
                                    if which_control = help_button then
                                        if Alert(aboutID, nil) = 1 then
                                            ;
                                end;
                        end;
                end;
            otherwise
                begin
                end;
        end; { case }
    end; { CheckMousePosition }

  {--------------------------------------------------------------------------}

    procedure GetKeyboardChar;
        var
            key: char;
            menu_ID: integer;
            stop_time: LongInt;

    begin { GetKeyboardChar }
        with current_event do
            begin
                key := chr((LoWord(message)));{Lo}
                if BitAnd(modifiers, cmdKey) <> 0 then
                    begin
                        menu_choice := MenuKey(key);
                        menu_ID := HiWord(menu_choice);
                        Delay(30, stop_time);
                        HiLiteMenu(menu_ID);
                        HandleMenuChoice;
                    end
                else
                    begin
                        this_char[1] := key;
                        byte_count := 1;
                        ErrorHandler(FSWrite(AOutRefNum, byte_count, @this_char));
                    end;
            end; { with }
    end; { GetKeyboardChar }

  {--------------------------------------------------------------------------}

    procedure WriteScreenLine;

    begin { WriteScreenLine }
        if Length(screen_line) > 0 then
            begin
                HideTheCursor;
                DrawString(screen_line);
                xPos := xPos + Length(screen_line) * char_space;
                if xPos > right_limit then
                    begin
                        CarriageReturn;
                        Linefeed;
                    end;
                screen_line[0] := chr(0);
                InvertCursor;
            end;
    end; { WriteScreenLine }

  {--------------------------------------------------------------------------}

    procedure DoUpdate (anEvent: EventRecord);
        var
            savePort: GrafPtr;
            theWindow: WindowPtr;
    begin {DoUpdate}
        theWindow := WindowPtr(anEvent.message);

        GetPort(savePort);
        SetPort(theWindow);
        BeginUpdate(theWindow);
{Handle update events!}
{If we had kept all text that has been drawn, we could redraw it!}

{Redraw buttons and the grow icon!}
        DrawGrowIcon(theWindow);
        DrawControls(theWindow);

        EndUpdate(theWindow);
        SetPort(savePort);
    end; {DoUpdate}

  {--------------------------------------------------------------------------}

    procedure CheckEventQueue;

    begin { CheckEventQueue }
        SystemTask;
        FlashCursor;
{Minor flaw: Should use WaitNextEvent if available. /Ingemar}
        if GetNextEvent(everyEvent, current_event) then
            case current_event.what of
                mouseDown:
                    CheckMousePosition;
                keyDown, autoKey:
                    GetKeyboardChar;
{Serious flaw: doesn't handle update events! /Ingemar}
                updateEvt:
                    DoUpdate(current_event);
                otherwise
                    begin
                    end;
            end; { case }
    end; { CheckEventQueue }

  {--------------------------------------------------------------------------}

begin { Serial }
    InitializeUserInterface;
    InitializeModemPort;
    repeat
        CheckEventQueue;
        FlashCursor;
        ErrorHandler(SerGetBuf(aInRefNum, byte_count));
        if byte_count > 0 then
            begin
                if byte_count > 64 then
                    byte_count := 64;
                ErrorHandler(FSRead(aInRefNum, byte_count, @in_buffer));
                limit := byte_count;
                for index := 1 to limit do
                    begin
                        received_char := in_buffer[index];
                        case ord(received_char) of
                            control_G:
                                begin
                                    WriteScreenLine;
                                    SysBeep(0);
                                end;
                            control_H:
                                begin
                                    WriteScreenLine;
                                    HideTheCursor;
                                    xPos := xPos - char_space;
                                    MoveTo(xPos, yPos);
                                    DrawChar(' ');
                                    MoveTo(xPos, yPos);
                                end;
                            control_J:
                                begin
                                    WriteScreenLine;
                                    Linefeed;
                                end;
                            control_M:
                                begin
                                    WriteScreenLine;
                                    CarriageReturn;
                                end;
                            $20..$FF:
                                begin
                                    len := ord(screen_line[0]) + 1;
                                    screen_line[0] := chr(len);
                                    screen_line[len] := received_char;
                                    if xPos + len * char_space > right_limit then
                                        begin
                                            WriteScreenLine;
                                            CarriageReturn;
                                            Linefeed;
                                        end;
                                end;
                            otherwise
                                begin
                                end;
                        end; { case }
                    end; { for }
            end;
        if Length(screen_line) > 0 then
            WriteScreenLine;
    until finished;
{RAMSDClose(SPortA);}
    if aInRefNum <> 0 then
        if CloseDriver(aInRefNum) <> noErr then
            ;
    if aOutRefNum <> 0 then
        if CloseDriver(aOutRefNum) <> noErr then
            ;

    DisposeWindow(terminal_window);
end.